home *** CD-ROM | disk | FTP | other *** search
/ The Utilities Experience / The Utilities Experience - Volume 1.iso / software / graphics / n-z / playkiss / src / l.e < prev    next >
Text File  |  1995-12-21  |  22KB  |  798 lines
  1.  
  2. /* Edit CEL v 0.78 */
  3.  
  4. /*
  5.     No copyright is claimed for *any* material within.
  6.   This source is *currently* Public Domain, and therefore open to free exploitation. */
  7.  
  8. /* Use at your own risk, and watch for hairy palms. */
  9.  
  10.  
  11. /*  November 9, 1994
  12.                                              Chad Randall 
  13.                                                         - mbissaymssiK Software, broken spork division
  14.                         Internet:  crandall@garnet.msen.com
  15.                             USNail:  229 S.Washington St.
  16.                                              Manchester, Michigan, 48158-9680 USA */
  17.  
  18. /* This sucker's not been tested but on my machine.  So let me know about any probs, 'kay? */
  19.  
  20. OPT LARGE
  21.  
  22. MODULE    'graphics/rastport','graphics/gfx','graphics/text','graphics/scale','graphics/view',
  23.                 'graphics/gfxbase','graphics/clip','graphics/layers','graphics/displayinfo'
  24. MODULE    'layers'
  25. MODULE    'intuition/intuition','intuition/screens','intuition/gadgetclass','intuition/screens',
  26.                 'intuition/pointerclass'
  27. MODULE    'libraries/gadtools','gadtools'
  28. MODULE    'dos/dos'
  29. MODULE    'libraries/asl','asl'
  30. MODULE    'tools/async'
  31. MODULE    'wb','workbench/workbench','workbench/startup'
  32. MODULE    'icon'
  33. MODULE    'exec/memory'
  34.  
  35. MODULE    '*doloaddt'
  36. MODULE    '*i3_subs'
  37.  
  38. ENUM OLD_,NEW_
  39. ENUM    DRAG_TOP,DRAG_PAUSE,DRAG_DIRTY,DRAG_BUFFER,DRAG_SMART
  40.  
  41. OBJECT color
  42.     red:LONG
  43.     grn:LONG
  44.     blu:LONG
  45. ENDOBJECT
  46.  
  47. OBJECT palet
  48.     color[260]:ARRAY OF color
  49. ENDOBJECT
  50.  
  51.  
  52. DEF filename[500]:STRING
  53. DEF paletname[500]:STRING
  54. DEF dtname[500]:STRING
  55. DEF ppmname[500]:STRING
  56.  
  57. DEF vp:PTR TO viewport,cm,depth,scrw,scrh,menu,vis
  58. DEF rp:PTR TO rastport,winw,winh
  59.  
  60. DEF quit=FALSE,newproj=FALSE
  61. DEF mode=0
  62. DEF config_size_x,config_size_y
  63.  
  64. DEF disp:PTR TO rastport
  65. DEF scr:PTR TO screen
  66. DEF win:PTR TO window,outwin:PTR TO window
  67. DEF fixxed=FALSE,rtdrag=4,waittof=TRUE,hand=FALSE,bound=TRUE
  68. DEF string[500]:STRING
  69. DEF iconbmap=0:PTR TO bitmap,iconwidth,iconheight,oldx,oldy
  70. DEF copybmap=0:PTR TO bitmap,copyrast:PTR TO rastport
  71. DEF backbmap=0:PTR TO bitmap,backrast:PTR TO rastport
  72. DEF maskbmap=0:PTR TO bitmap
  73. DEF blankbmap=0:PTR TO bitmap,maximumw=1,maximumh=1
  74. DEF palet=0:PTR TO palet
  75. DEF hand1=0,hand2=0,hand3=0
  76. DEF curobj=0,offx,offy,dragmode=0
  77. DEF filereq=0:PTR TO filerequester
  78. DEF paletreq=0:PTR TO filerequester
  79. DEF dtreq=0:PTR TO filerequester
  80. DEF ppmreq=0:PTR TO filerequester
  81. ENUM OFF=FALSE,ON=TRUE
  82. DEF outputmode=0
  83. DEF pauseflag=FALSE
  84. DEF iinfo:PTR TO imageinfo
  85. DEF goodload,xsize,ysize,nxsize,nysize,xoff,yoff
  86.  
  87. CONST FILE_MARK_CELL=$20,FILE_MARK_PALET=$10
  88.  
  89.  
  90. RAISE "CHIP" IF AllocBitMap()=FALSE
  91. RAISE "MEM" IF AllocMem()=FALSE
  92. RAISE "MEM" IF New()=FALSE
  93. RAISE "^C" IF CtrlC()=TRUE
  94.  
  95. PROC version()
  96.     WriteF('\s',{versionstring})
  97. ENDPROC
  98.  
  99. versionstring:
  100. CHAR    '\0$VER: edit cel 0.78 (21.11.94) \tPUBLIC DOMAIN --- NOT FOR RESALE\0\0'
  101.  
  102. PROC reportmousemoves(win:PTR TO window)
  103.     Forbid()
  104.     win.flags:=win.flags OR WFLG_REPORTMOUSE
  105.     Permit()
  106. ENDPROC
  107. PROC noreportmousemoves(win:PTR TO window);DEF flag
  108.     Forbid()
  109.     flag:=win.flags
  110.     IF (flag AND WFLG_REPORTMOUSE) THEN flag:=flag-WFLG_REPORTMOUSE
  111.     win.flags:=flag
  112.     Permit()
  113. ENDPROC
  114.  
  115. PROC busy()
  116.     SetWindowPointerA(win,[$80000098,TRUE,WA_POINTERDELAY,TRUE,NIL,NIL])
  117.     ModifyIDCMP(win,IDCMP_MENUPICK)
  118.     StrCopy(string,'Edit CEL 0.78  *BUSY*',ALL)
  119.     SetWindowTitles(win,-1,string)
  120. ENDPROC
  121.  
  122. PROC ready()
  123.     ClearPointer(win)
  124.     ModifyIDCMP(win,IDCMP_MENUPICK OR IDCMP_MENUVERIFY)
  125.     StringF(string,'Edit CEL 0.78  (\dx\d)',xsize,ysize)
  126.     SetWindowTitles(win,-1,string)
  127. ENDPROC
  128.  
  129.  
  130. PROC main() HANDLE
  131.     DEF i,ii,t,zz,tt,zzz
  132.     DEF mes:PTR TO intuimessage
  133.     DEF hit,hitflag=0,palload=0,iadd:PTR TO menuitem,drawx,drawy
  134.     DEF dir[500]:STRING,file[250]:STRING,buffer
  135.     DEF args:PTR TO wbarg,wstr[250]:STRING,toolobject=NIL:PTR TO diskobject
  136.     DEF region1,rectangle:PTR TO rectangle
  137.     DEF olddir,dirrr,wb:PTR TO wbstartup
  138.     DEF argarray[32]:LIST,rdarg=0,gotme=0,check,code=0,du=0
  139.     DEF zx,zy,zw,zh,zox,zoy
  140.     DEF oldfh=0,newfh=0,filebuf=0,bufptr,filelen=1
  141.     DEF menuverify=FALSE
  142.     DEF fh1,fbuf=0,byte_h,byte_l,r,g,b,bpp,numc
  143.  
  144.     IF (KickVersion(39)=0)
  145.         Raise("Kick")
  146.     ENDIF
  147.  
  148.     buffer:=New(260*16)
  149.     NEW palet,iinfo
  150.     IF (iconbase:=OpenLibrary('icon.library', 37))=NIL THEN Raise("LIB")
  151.     IF (aslbase:=OpenLibrary('asl.library', 37))=NIL THEN Raise("LIB")
  152.     IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN Raise("LIB")
  153.     IF (layersbase:=OpenLibrary('layers.library',37))=NIL THEN Raise("LIB")
  154.  
  155.     IF wbmessage<>NIL
  156.         outputmode:=TRUE
  157.         wb:=wbmessage;args:=wb.arglist
  158.         olddir:=CurrentDir(args.lock)
  159.         IF args.name>0
  160.             GetCurrentDirName(wstr,250)
  161.             StrCopy(filename,wstr,ALL);AddPart(filename,'',490)
  162.             StrAdd(wstr,args.name,ALL)
  163.             toolobject:=GetDiskObjectNew(wstr)
  164.             CurrentDir(olddir)
  165.         ENDIF
  166.         IF wb.numargs>1
  167.             olddir:=args[].lock++ ->skip our lock! olddir is meaningless at this point
  168.             IF args.lock
  169.                 olddir:=CurrentDir(args.lock)
  170.                 GetCurrentDirName(filename,490)
  171.                 NameFromLock(args.lock,wstr,240)
  172.                 CurrentDir(olddir)
  173.                 AddPart(filename,args.name,490)
  174.                 StrCopy(dtname,filename,ALL)
  175.                 StrCopy(ppmname,filename,ALL)
  176.                 StrCopy(paletname,filename,ALL)
  177.             ENDIF
  178.         ENDIF
  179.         IF (toolobject<>0)
  180.             IF (du:=FindToolType(toolobject.tooltypes,'DEPTH'))
  181.                 StrToLong(du,{rtdrag})
  182.                 IF rtdrag<4 THEN rtdrag:=4
  183.                 IF rtdrag>4 THEN rtdrag:=8
  184.             ENDIF
  185.             IF (du:=FindToolType(toolobject.tooltypes,'PICTURE_DIRECTORY'))
  186.                 StrCopy(dtname,du,ALL)
  187.                 AddPart(dtname,'',490)
  188.                 StrCopy(ppmname,du,ALL)
  189.                 AddPart(ppmname,'',490)
  190.             ENDIF
  191.             IF (du:=FindToolType(toolobject.tooltypes,'PICDIR'))
  192.                 StrCopy(dtname,du,ALL)
  193.                 AddPart(dtname,'',490)
  194.             ENDIF
  195.             IF (du:=FindToolType(toolobject.tooltypes,'KISS_DIRECTORY'))
  196.                 StrCopy(filename,du,ALL)
  197.                 AddPart(filename,'',490)
  198.                 StrCopy(paletname,du,ALL)
  199.                 AddPart(paletname,'',490)
  200.             ENDIF
  201.             IF (du:=FindToolType(toolobject.tooltypes,'CELDIR'))
  202.                 StrCopy(filename,du,ALL)
  203.                 AddPart(filename,'',490)
  204.             ENDIF
  205.             IF (du:=FindToolType(toolobject.tooltypes,'KCFDIR'))
  206.                 StrCopy(paletname,du,ALL)
  207.                 AddPart(paletname,'',490)
  208.             ENDIF
  209.             IF (du:=FindToolType(toolobject.tooltypes,'INITIAL_KCF'))
  210.                 StrCopy(paletname,du,ALL)
  211.                 palload:=555
  212.             ENDIF
  213.             FreeDiskObject(toolobject)
  214.         ENDIF
  215.     ELSE
  216.         FOR i:=0 TO 30
  217.             argarray[i]:=NIL
  218.         ENDFOR
  219.         rdarg:=ReadArgs('WORKDIR=K,PICDIR=P,KCF/K,DEPTH=D/N',argarray,0)
  220.         IF rdarg
  221.             IF argarray[0]
  222.                 StrCopy(filename,argarray[0],ALL)
  223.                 AddPart(filename,'',490)
  224.                 StrCopy(paletname,argarray[0],ALL)
  225.                 AddPart(paletname,'',490)
  226.                 StrCopy(dtname,argarray[0],ALL)
  227.                 AddPart(dtname,'',490)
  228.                 StrCopy(ppmname,argarray[0],ALL)
  229.                 AddPart(ppmname,'',490)
  230.             ENDIF
  231.             IF argarray[1]
  232.                 StrCopy(dtname,argarray[1],ALL)
  233.                 AddPart(dtname,'',490)
  234.                 StrCopy(ppmname,argarray[1],ALL)
  235.                 AddPart(ppmname,'',490)
  236.             ENDIF
  237.             IF argarray[2]
  238.                 StrCopy(paletname,argarray[2],ALL)
  239.                 palload:=555
  240.             ENDIF
  241.             IF argarray[3]
  242.                 rtdrag:=argarray[3]
  243.                 rtdrag:=^rtdrag
  244.                 IF rtdrag<4 THEN rtdrag:=4
  245.                 IF rtdrag>4 THEN rtdrag:=8
  246.             ENDIF
  247.             FreeArgs(rdarg)
  248.         ENDIF
  249.     ENDIF
  250.  
  251.     filereq:=AllocAslRequest(ASL_FILEREQUEST,[ASLFR_INITIALPATTERN,'#?.CEL',NIL,NIL])
  252.     paletreq:=AllocAslRequest(ASL_FILEREQUEST,[ASLFR_INITIALPATTERN,'#?.KCF',NIL,NIL])
  253.     dtreq:=AllocAslRequest(ASL_FILEREQUEST,[ASLFR_INITIALPATTERN,'#?',NIL,NIL])
  254.     ppmreq:=AllocAslRequest(ASL_FILEREQUEST,[ASLFR_INITIALPATTERN,'#?.ppm',NIL,NIL])
  255.  
  256.     scr:=LockPubScreen('Workbench')
  257.     config_size_x:=scr.width
  258.     config_size_y:=(scr.height+scr.barheight+1)
  259.     UnlockPubScreen(0,scr);scr:=0
  260.     openscreen(rtdrag)
  261.     GetRGB32(cm,0,256,buffer)
  262.     FOR i:=0 TO 255
  263.         palet.color[i].red:=Long(buffer+(i*12))
  264.         palet.color[i].grn:=Long(buffer+(i*12)+4)
  265.         palet.color[i].blu:=Long(buffer+(i*12)+8)
  266.     ENDFOR
  267.     WHILE quit=FALSE
  268.         updatecolors()
  269.         WHILE ((quit=FALSE) AND (newproj=FALSE))
  270.             Wait(-1)
  271.             CtrlC()
  272.             hitflag:=0
  273.             WHILE (mes:=Gt_GetIMsg(win.userport))
  274.                 IF (mes.class=IDCMP_MENUVERIFY)
  275.                     menucolors(buffer)
  276.                 ENDIF
  277.                 IF (mes.class=IDCMP_MENUPICK)
  278.                     code:=mes.code
  279.                     WHILE (code<>MENUNULL)
  280.                         iadd:=ItemAddress(menu,code)
  281.                         IF iadd
  282.                             hit:=Long(iadd+34)
  283.                             check:=(Int(iadd+12) AND CHECKED)
  284.                             IF ((hit>0) AND (hit<10)) THEN hitflag:=hit
  285.                             IF hit=66 THEN quit:=TRUE
  286.                             code:=iadd.nextselect
  287.                         ELSE
  288.                             code:=MENUNULL
  289.                         ENDIF
  290.                     ENDWHILE
  291.                     updatecolors()
  292.                 ENDIF
  293.           Gt_ReplyIMsg(mes)
  294.             ENDWHILE
  295.             IF (palload) THEN hitflag:=1
  296.             SELECT hitflag
  297.             CASE 1
  298.                 busy()
  299.                 IF palload=0
  300.                     WbenchToFront()
  301.                     splitname(paletname,dir,file)
  302.                     ii:=AslRequest(paletreq,[ASL_HAIL,'Select .KCF file',
  303.                             ASL_OKTEXT,'_Open',ASL_FILE,file,ASL_DIR,dir,
  304.                             ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,FALSE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  305.                     WbenchToBack()
  306.                 ELSE
  307.                     ii:=TRUE
  308.                 ENDIF
  309.                 IF ii
  310.                     IF palload=0
  311.                         StrCopy(paletname,paletreq.drawer,ALL)
  312.                         AddPart(paletname,paletreq.file,490)
  313.                     ENDIF
  314.                     fh1:=Open(paletname,MODE_OLDFILE)
  315.                     IF fh1
  316.                         fbuf:=New(500)
  317.                         Read(fh1,fbuf,32)
  318.                         IF Long(fbuf)="KiSS"
  319.                             IF Char(fbuf+4)=FILE_MARK_PALET
  320.                                 bpp:=Char(fbuf+5)
  321.                                 numc:=ibmconv(Int(fbuf+8))
  322.                                 FOR i:=0 TO numc-1
  323.                                     IF bpp=12
  324.                                         Read(fh1,fbuf,2)
  325.                                         byte_l:=Char(fbuf)
  326.                                         byte_h:=Char(fbuf+1)
  327.                                         r:=(Shr(byte_l,4) AND $F)*$1111
  328.                                         g:=(byte_h AND $F)*$1111
  329.                                         b:=(byte_l AND $F)*$1111
  330.                                     ELSE
  331.                                         Read(fh1,fbuf,1);r:=Shl(Char(fbuf),8) OR Char(fbuf)
  332.                                         Read(fh1,fbuf,1);g:=Shl(Char(fbuf),8) OR Char(fbuf)
  333.                                         Read(fh1,fbuf,1);b:=Shl(Char(fbuf),8) OR Char(fbuf)
  334.                                     ENDIF
  335.                                     r:=(Shl(Shl(r,8),8) OR r)
  336.                                     g:=(Shl(Shl(g,8),8) OR g)
  337.                                     b:=(Shl(Shl(b,8),8) OR b)
  338.                                     palet.color[i].red:=r
  339.                                     palet.color[i].grn:=g
  340.                                     palet.color[i].blu:=b
  341.                                 ENDFOR
  342.                             ENDIF
  343.                         ELSE
  344.                             Seek(fh1,0,OFFSET_BEGINNING)
  345.                             FOR i:=0 TO 15
  346.                                 Read(fh1,fbuf,2)
  347.                                 byte_l:=Char(fbuf)
  348.                                 byte_h:=Char(fbuf+1)
  349.                                 r:=(Shr(byte_l,4) AND $F)*$1111
  350.                                 g:=(byte_h AND $F)*$1111
  351.                                 b:=(byte_l AND $F)*$1111
  352.                                 r:=(Shl(Shl(r,8),8) OR r)
  353.                                 g:=(Shl(Shl(g,8),8) OR g)
  354.                                 b:=(Shl(Shl(b,8),8) OR b)
  355.                                 palet.color[i].red:=r
  356.                                 palet.color[i].grn:=g
  357.                                 palet.color[i].blu:=b
  358.                             ENDFOR
  359.                         ENDIF
  360.                         Dispose(fbuf)
  361.                         Close(fh1)
  362.                         updatecolors()
  363.                     ENDIF
  364.                 ENDIF
  365.             CASE 2
  366.                 busy()
  367.                 WbenchToFront()
  368.                 splitname(filename,dir,file)
  369.                 ii:=AslRequest(filereq,[ASL_HAIL,'Select .CEL file',
  370.                         ASL_OKTEXT,'_Open',ASL_FILE,file,ASL_DIR,dir,
  371.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,FALSE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  372.                 WbenchToBack()
  373.                 IF ii
  374.                     StrCopy(filename,filereq.drawer,ALL)
  375.                     AddPart(filename,filereq.file,490)
  376.                     fh1:=Open(filename,MODE_OLDFILE)
  377.                     IF fh1
  378.                         fbuf:=New(8000)
  379.                         SetRast(rp,0)
  380.                         Read(fh1,fbuf,4)
  381.                         IF Long(fbuf)="KiSS"
  382.                             Read(fh1,fbuf,28)
  383.                             IF Char(fbuf)=FILE_MARK_CELL
  384.                                 nxsize:=ibmconv(Int(fbuf+4))
  385.                                 nysize:=ibmconv(Int(fbuf+6))
  386.                                 xoff:=ibmconv(Int(fbuf+8))
  387.                                 yoff:=ibmconv(Int(fbuf+10))
  388.                                 xsize:=nxsize+xoff
  389.                                 ysize:=nysize+yoff
  390.                                 bpp:=Char(fbuf+1)
  391.                                 IF bpp=4
  392.                                     FOR t:=0 TO nysize-1
  393.                                         Read(fh1,fbuf,(nxsize/2))
  394.                                         FOR i:=0 TO (nxsize-1) STEP 2
  395.                                             byte_h:=Char(fbuf+(i/2))
  396.                                             SetAPen(rp,Shr(byte_h AND $F0,4))
  397.                                             WritePixel(rp,xoff+i,yoff+t)
  398.                                             SetAPen(rp,byte_h AND $F)
  399.                                             WritePixel(rp,xoff+i+1,yoff+t)
  400.                                         ENDFOR
  401.                                     ENDFOR
  402.                                 ELSE
  403.                                     FOR t:=0 TO nysize-1
  404.                                         Read(fh1,fbuf,nxsize)
  405.                                         FOR i:=0 TO nxsize-1
  406.                                             byte_h:=Char(fbuf+i)
  407.                                             SetAPen(rp,byte_h)
  408.                                             WritePixel(rp,xoff+i,xoff+t)
  409.                                         ENDFOR
  410.                                     ENDFOR
  411.                                 ENDIF
  412.                             ELSE
  413.                                 DisplayBeep(0)
  414.                             ENDIF
  415.                         ELSE
  416.                             nxsize:=ibmconv(Int(fbuf))
  417.                             nysize:=ibmconv(Int(fbuf+2))
  418.                             IF ((nxsize<2) OR (nxsize>640) OR (nysize<2) OR (nysize>400))
  419.                                 DisplayBeep(0)
  420.                             ELSE
  421.                                 xsize:=((nxsize)/2)*2
  422.                                 ysize:=nysize
  423.                                 FOR t:=0 TO ysize-1
  424.                                     Read(fh1,fbuf,(xsize/2))
  425.                                     FOR i:=0 TO (xsize-1) STEP 2
  426.                                         byte_h:=Char(fbuf+(i/2))
  427.                                         SetAPen(rp,Shr(byte_h AND $F0,4))
  428.                                         WritePixel(rp,i,t)
  429.                                         SetAPen(rp,byte_h AND $F)
  430.                                         WritePixel(rp,i+1,t)
  431.                                     ENDFOR
  432.                                 ENDFOR
  433.                             ENDIF
  434.                         ENDIF
  435.                         Dispose(fbuf)
  436.                         Close(fh1)
  437.                     ENDIF
  438.                 ENDIF
  439.             CASE 3
  440.                 busy()
  441.                 WbenchToFront()
  442.                 splitname(dtname,dir,file)
  443.                 ii:=AslRequest(dtreq,[ASL_HAIL,'Select Picture file',
  444.                         ASL_OKTEXT,'_Open',ASL_FILE,file,ASL_DIR,dir,
  445.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,FALSE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  446.                 WbenchToBack()
  447.                 IF ii
  448.                     StrCopy(dtname,dtreq.drawer,ALL)
  449.                     AddPart(dtname,dtreq.file,490)
  450.                 ENDIF
  451.                 goodload:=(doloaddt(dtname,rp,cm,0,0,config_size_x,config_size_y,[DLDT_CENTER,FALSE,
  452.                     DLDT_INTEGERSCALE,FALSE,
  453.                     DLDT_DITHER,TRUE,
  454.                     DLDT_REMAP,TRUE,
  455.                     DLDT_ASPECTX,1,
  456.                     DLDT_ASPECTY,1,
  457.                     DLDT_SCALE,TRUE,
  458.                     DLDT_USEASPECT,TRUE,
  459.                     DLDT_ENLARGE,FALSE,
  460.                     DLDT_CLEAR,TRUE,
  461.                     DLDT_INFO,iinfo,
  462.                     DLDT_HIGHPEN,-1,NIL,NIL]))
  463.                 IF goodload=0
  464.                     xsize:=(iinfo.destination_w+1)/2*2
  465.                     ysize:=iinfo.destination_h
  466.                 ENDIF
  467.             CASE 4
  468.                 menucolors(buffer)
  469.                 EasyRequestArgs(win,[20,0,'Load .ppm file...',
  470.                     'Loading a .ppm file is not implemented yet.',
  471.                     'Ok'],0,0)
  472.                 updatecolors()
  473. ->                busy()
  474. ->                WbenchToFront()
  475. ->                splitname(ppmname,dir,file)
  476. ->                ii:=AslRequest(ppmreq,[ASL_HAIL,'Select ppm file',
  477. ->                        ASL_OKTEXT,'_Open',ASL_FILE,file,ASL_DIR,dir,
  478. ->                        ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,FALSE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  479. ->                WbenchToBack()
  480. ->                IF ii
  481. ->                    StrCopy(ppmname,ppmreq.drawer,ALL)
  482. ->                    AddPart(ppmname,ppmreq.file,490)
  483. ->                ENDIF
  484.             CASE 5
  485.                 busy()
  486.                 WbenchToFront()
  487.                 splitname(paletname,dir,file)
  488.                 ii:=AslRequest(paletreq,[ASL_HAIL,'Select .KCF file',
  489.                         ASL_OKTEXT,'_Save',ASL_FILE,file,ASL_DIR,dir,
  490.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,TRUE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  491.                 WbenchToBack()
  492.                 IF ii
  493.                     StrCopy(paletname,paletreq.drawer,ALL)
  494.                     AddPart(paletname,paletreq.file,490)
  495.                     fh1:=Open(paletname,MODE_NEWFILE)
  496.                     IF fh1
  497.                         fbuf:=New(500)
  498.                         FOR i:=0 TO 31
  499.                             PutChar(fbuf,0)
  500.                         ENDFOR
  501.                         PutLong(fbuf,"KiSS")
  502.                         PutChar(fbuf+4,FILE_MARK_PALET)
  503.                         PutChar(fbuf+5,24)
  504.                         PutInt(fbuf+8,ibmconv(IF depth=4 THEN 16 ELSE 256))
  505.                         Write(fh1,fbuf,32)
  506.                         FOR t:=0 TO 9
  507.                             FOR i:=0 TO IF (depth=4) THEN 15 ELSE 255
  508.                                 PutChar(fbuf+(i*3),palet.color[i].red)
  509.                                 PutChar(fbuf+(i*3)+1,palet.color[i].grn)
  510.                                 PutChar(fbuf+(i*3)+2,palet.color[i].blu)
  511.                             ENDFOR
  512.                             Write(fh1,fbuf,IF (depth=4) THEN 16*3 ELSE 256*3)
  513.                         ENDFOR
  514.                         Dispose(fbuf)
  515.                         Close(fh1)
  516.                     ENDIF
  517.                 ENDIF
  518.             CASE 6
  519.                 busy()
  520.                 WbenchToFront()
  521.                 splitname(filename,dir,file)
  522.                 ii:=AslRequest(filereq,[ASL_HAIL,'Select .CEL file',
  523.                         ASL_OKTEXT,'_Save',ASL_FILE,file,ASL_DIR,dir,
  524.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,TRUE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  525.                 WbenchToBack()
  526.                 IF ii
  527.                     StrCopy(filename,filereq.drawer,ALL)
  528.                     AddPart(filename,filereq.file,490)
  529.                     xoff:=xsize
  530.                     SetAPen(rp,1)
  531.                     FOR i:=0 TO ysize
  532.                         FOR t:=0 TO xoff
  533.                             IF ReadPixel(rp,t,i)<>0
  534.                                 xoff:=smaller(xoff,t)
  535.                                 t:=xoff
  536.                             ENDIF
  537.                         ENDFOR
  538.                     ENDFOR
  539.                     yoff:=ysize
  540.                     FOR i:=0 TO xsize
  541.                         FOR t:=0 TO yoff
  542.                             IF ReadPixel(rp,i,t)<>0
  543.                                 yoff:=smaller(yoff,t)
  544.                                 t:=yoff
  545.                             ENDIF
  546.                         ENDFOR
  547.                     ENDFOR
  548.                     xsize:=((xsize-xoff+1)/2)*2+1
  549.                     ysize:=ysize-yoff+1
  550.                     ClipBlit(rp,xoff,yoff,rp,0,0,xsize,ysize,192)
  551.                     SetAPen(rp,0)
  552.                     RectFill(rp,xsize,0,3000,2000)
  553.                     RectFill(rp,0,ysize,3000,2000)
  554.  
  555.  
  556.                     nxsize:=0
  557.                     FOR i:=ysize TO 0 STEP -1
  558.                         FOR t:=xsize TO nxsize STEP -1
  559.                             IF ReadPixel(rp,t,i)<>0
  560.                                 nxsize:=t
  561.                                 t:=nxsize
  562.                             ENDIF
  563.                         ENDFOR
  564.                     ENDFOR
  565.                     nysize:=0
  566.                     FOR i:=xsize TO 0 STEP -1
  567.                         FOR t:=ysize TO nysize STEP -1
  568.                             IF ReadPixel(rp,i,t)<>0
  569.                                 nysize:=t
  570.                                 t:=nysize
  571.                             ENDIF
  572.                         ENDFOR
  573.                     ENDFOR
  574.                     xsize:=((nxsize+1)/2)*2+1
  575.                     ysize:=nysize+1
  576.  
  577.                     fh1:=Open(filename,MODE_NEWFILE)
  578.                     IF fh1
  579.                         fbuf:=New(6000)
  580.                         FOR i:=0 TO 31
  581.                             PutChar(fbuf,0)
  582.                         ENDFOR
  583.                         PutLong(fbuf,"KiSS")
  584.                         PutChar(fbuf+4,FILE_MARK_CELL)
  585.                         PutChar(fbuf+5,IF (depth=4) THEN 4 ELSE 8)
  586.                         PutInt(fbuf+8, ibmconv(xsize))
  587.                         PutInt(fbuf+10,ibmconv(ysize))
  588.                         PutInt(fbuf+12,ibmconv(xoff))
  589.                         PutInt(fbuf+14,ibmconv(yoff))
  590.                         Write(fh1,fbuf,32)
  591.                         IF (depth=4)
  592.                             FOR t:=0 TO ysize-1
  593.                                 FOR i:=0 TO (xsize-1) STEP 2
  594.                                     PutChar(fbuf+(i/2),(Shl(ReadPixel(rp,i,t) AND $F,4) OR (ReadPixel(rp,i+1,t) AND $F)))
  595.                                 ENDFOR
  596.                                 Write(fh1,fbuf,(xsize/2))
  597.                             ENDFOR
  598.                         ELSE
  599.                             FOR t:=0 TO ysize-1
  600.                                 FOR i:=0 TO xsize-1
  601.                                     PutChar(fbuf+i,ReadPixel(rp,i,t))
  602.                                 ENDFOR
  603.                                 Write(fh1,fbuf,xsize)
  604.                             ENDFOR
  605.                         ENDIF
  606.                         Close(fh1)
  607.                         Dispose(fbuf)
  608.                     ENDIF
  609.                 ENDIF
  610.                 ClipBlit(rp,0,0,rp,xoff,yoff,xsize,ysize,192)
  611.                 SetAPen(rp,0)
  612.                 IF ((xoff>0)) THEN     RectFill(rp,0,0,xoff-1,1000)
  613.                 IF ((yoff>0)) THEN     RectFill(rp,0,0,1000,yoff-1)
  614.                 xsize:=xsize+xoff
  615.                 ysize:=ysize+yoff
  616.             CASE 7
  617.                 busy()
  618.                 WbenchToFront()
  619.                 splitname(dtname,dir,file)
  620.                 ii:=AslRequest(dtreq,[ASL_HAIL,'Select IFF file',
  621.                         ASL_OKTEXT,'_Save',ASL_FILE,file,ASL_DIR,dir,
  622.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,TRUE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  623.                 WbenchToBack()
  624.                 IF ii
  625.                     StrCopy(dtname,dtreq.drawer,ALL)
  626.                     AddPart(dtname,dtreq.file,490)
  627.                 ENDIF
  628.             CASE 8
  629.                 busy()
  630.                 WbenchToFront()
  631.                 splitname(ppmname,dir,file)
  632.                 ii:=AslRequest(ppmreq,[ASL_HAIL,'Select ppm file',
  633.                         ASL_OKTEXT,'_Save',ASL_FILE,file,ASL_DIR,dir,
  634.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,TRUE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  635.                 WbenchToBack()
  636.                 IF ii
  637.                     StrCopy(ppmname,ppmreq.drawer,ALL)
  638.                     AddPart(ppmname,ppmreq.file,490)
  639.                 ENDIF
  640.             CASE 9
  641.                 menucolors(buffer)
  642.                 EasyRequestArgs(win,[20,0,'About Edit CEL v0.78',
  643.                     'Written in a few hours by\nChad Randall\ncrandall@garnet.msen.com',
  644.                     'Ok'],0,0)
  645.                 updatecolors()
  646.             ENDSELECT
  647.             ready();palload:=FALSE
  648.         ENDWHILE
  649.     ENDWHILE    
  650.     closescreen()
  651. EXCEPT DO
  652.     closescreen()
  653.     Dispose(buffer)
  654.     IF ((exception="^C") AND (outputmode=0)) THEN WriteF('***BREAK\n')
  655.     IF ((exception="Kick"))
  656.         WriteF('You need at least OS 3.0 (Kickstart 39) to run.\n')
  657.         DisplayBeep(0)
  658.     ENDIF
  659.     IF filereq THEN FreeAslRequest(filereq)
  660.     IF dtreq THEN FreeAslRequest(dtreq)
  661.     IF paletreq THEN FreeAslRequest(paletreq)
  662.     IF ppmreq THEN FreeAslRequest(ppmreq)
  663.  
  664.     IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  665.     IF layersbase THEN CloseLibrary(layersbase)
  666.     IF aslbase THEN CloseLibrary(aslbase)
  667.     IF iconbase THEN CloseLibrary(iconbase)
  668.     END palet
  669. ENDPROC
  670.  
  671. PROC menucolors(buffer)
  672.     DEF i
  673.     FOR i:=0 TO 3
  674.         SetRGB32(vp,i,Long(buffer+(i*12)),Long(buffer+(i*12)+4),Long(buffer+(i*12)+8))
  675.     ENDFOR
  676.     FOR i:=17 TO 19
  677.         SetRGB32(vp,i,Long(buffer+(i*12)),Long(buffer+(i*12)+4),Long(buffer+(i*12)+8))
  678.     ENDFOR
  679.     FOR i:=(Shl(1,rtdrag)-4) TO (Shl(1,rtdrag)-1)
  680.         SetRGB32(vp,i,Long(buffer+(i*12)),Long(buffer+(i*12)+4),Long(buffer+(i*12)+8))
  681.     ENDFOR
  682. ENDPROC
  683.  
  684. PROC updatecolors()
  685.     DEF i,pn=0,t
  686.     FOR i:=0 TO 255
  687.         SetRGB32(vp,i,palet.color[i].red,palet.color[i].grn,palet.color[i].blu)
  688.     ENDFOR
  689. ENDPROC
  690.  
  691. PROC isdigit(s);IF (((s>="0") AND (s<="9")) OR (s=".") OR (s="-")) THEN RETURN TRUE;ENDPROC FALSE
  692. PROC isalpha(s);IF (((s>="a") AND (s<="z")) OR ((s>="A") AND (s<="Z"))) THEN RETURN TRUE;ENDPROC FALSE
  693. PROC ispunc(s);IF ((s=".") OR (s="-") OR (s="_")) THEN RETURN TRUE;ENDPROC FALSE
  694.  
  695. PROC scanforvalue(str)
  696.     DEF l=0,i,s[100]:STRING,ins,iii=0
  697.     WHILE (isdigit(Char(str+l)));l:=l+1;ENDWHILE
  698.     StrCopy(s,str,l)
  699.     ins:=InStr(str,'.')
  700.     IF ((ins>0) AND (ins<=l))
  701.         StrToLong(s,{i})
  702.         StrToLong(s+ins+1,{iii})
  703.     ELSE
  704.         StrToLong(s,{i})
  705.     ENDIF
  706. ENDPROC i,l,iii
  707.  
  708. PROC scanforstring(str)
  709.     DEF l=0
  710.     WHILE (isdigit(Char(str+l)) OR isalpha(Char(str+l)) OR ispunc(Char(str+l)));l:=l+1;ENDWHILE
  711. ENDPROC l
  712.  
  713. PROC ibmconv(a)
  714.     DEF hi,lo,ret
  715.     hi:=a AND $FF00
  716.     lo:=a AND $00FF
  717.     ret:=Shl(lo,8) OR Shr(hi,8)
  718. ENDPROC ret
  719.  
  720. PROC openscreen(d)
  721.     DEF cflag,lflag1=CHECKIT,lflag2=CHECKIT,lflag3=CHECKIT,lflag4=CHECKIT,lflag5=CHECKIT,lflag=CHECKIT
  722.     DEF hflag1=CHECKIT,hflag2=CHECKIT,hflag3=CHECKIT,bflag=CHECKIT
  723.     depth:=d
  724.     scr:=OpenScreenTagList(NIL,[SA_LIKEWORKBENCH,TRUE,
  725.         SA_DEPTH,depth,
  726.         SA_TITLE,'Edit CEL',
  727.         SA_COLORMAPENTRIES,256,
  728.         SA_FULLPALETTE,TRUE,
  729.         SA_WIDTH,config_size_x,
  730.         SA_HEIGHT,config_size_y,
  731.         SA_INTERLEAVED,TRUE,
  732.         SA_AUTOSCROLL,TRUE,
  733.         SA_PENS,[-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1]:INT,
  734.         NIL,NIL])
  735.     IF scr=0 THEN Raise("SCR")
  736.     IF (vis:=GetVisualInfoA(scr,NIL))=0 THEN RETURN "VIS"
  737.     win:=OpenWindowTagList(0,[WA_WIDTH,scr.width,WA_HEIGHT,scr.height-scr.barheight-1,
  738.         WA_TOP,scr.barheight+1,WA_LEFT,0,
  739.         WA_FLAGS,WFLG_ACTIVATE OR WFLG_SMART_REFRESH,
  740.         WA_BORDERLESS,TRUE,
  741.         WA_BACKDROP,TRUE,
  742.         WA_CUSTOMSCREEN,scr,
  743.         WA_NEWLOOKMENUS,TRUE,
  744.         WA_IDCMP,IDCMP_MENUPICK OR IDCMP_MENUVERIFY,
  745.         NIL,NIL])
  746.     IF win=0 THEN Raise("WIN")
  747.     vp:=scr.viewport
  748.     cm:=vp.colormap
  749.     rp:=win.rport
  750.  
  751.   IF (menu:=CreateMenusA([NM_TITLE,0,'Project',0,0,0,0,
  752.                                                     NM_ITEM,0,'Open KCF...','K',0,0,1,
  753.                                                     NM_ITEM,0,'Open CEL...','C',0,0,2,
  754.                                                     NM_ITEM,0,'Open Datatype...','O',0,0,3,
  755.                                                     NM_ITEM,0,'Open PPM (P6)','P',0,0,4,
  756.                                                     NM_ITEM,0,NM_BARLABEL,0,0,0,0,
  757.                                                     NM_ITEM,0,'Save KCF','F',0,0,5,
  758.                                                     NM_ITEM,0,'Save CEL','E',0,0,6,
  759.                                                     NM_ITEM,0,'Save IFF','I',0,0,7,
  760.                                                     NM_ITEM,0,'Save PPM (P6)','B',0,0,8,
  761.                                                     NM_ITEM,0,NM_BARLABEL,0,0,0,0,
  762.                                                     NM_ITEM,0,'About','?',0,0,9,
  763.                                                     NM_ITEM,0,'Quit','Q',0,0,66,
  764.  
  765.                                                     NM_END,0,'End','x',0,0,0]:newmenu,NIL))=NIL THEN Raise("MENU")
  766.     LayoutMenusA(menu,vis,[GTMN_NEWLOOKMENUS,TRUE,NIL,NIL])
  767.     SetMenuStrip(win,menu)
  768.     offmenu(4)
  769.     offmenu(7)
  770.     offmenu(8)
  771. ENDPROC
  772.  
  773. PROC offmenu(id)
  774.     DEF a,b,c
  775.     a,b,c:=findmenuid(menu,id)
  776.     IF win THEN OffMenu(win,packmenunumber(a,b,c))
  777. ENDPROC
  778.  
  779. PROC closescreen()
  780.     IF win
  781.         CloseWindow(win)
  782.         win:=0
  783.     ENDIF
  784.     IF menu
  785.         FreeMenus(menu)
  786.         menu:=0
  787.     ENDIF
  788.     IF vis
  789.         FreeVisualInfo(vis)
  790.         vis:=0
  791.     ENDIF
  792.     IF scr
  793.         CloseScreen(scr)
  794.         scr:=0
  795.     ENDIF
  796.  
  797. ENDPROC
  798.